(library (grid-gen optimizer)

(export optimizer:set-max-const-rank)

(import (guile)
        (rnrs)
        (except (srfi srfi-1) map)
        (grid-gen main)
        (grid-gen vars)
        (grid-gen code)
        (grid-gen math)
        (grid-gen symath)
        (statprof)
        (ice-9 threads)
        (ice-9 futures)
        (ice-9 match)
)

(define andmap every)
(define ormap any)

(define is-ref? (lambda (e)
  (and (list? e) (= (length e) 2) (eq? (car e) 'REF))
))

(define e-c-ptr (lambda (p lp)
  (if (eq? p 'CUR_PTR) (map cur-ptr (iota1 lp)) p)
))

(def-cache adj-ex-idx (lambda (ex np lp prc)
  (cond ((and (is-ptr? ex) (= (cadr ex) np)) (prc ex))
        ((and (is-var? ex) (var-has-ind? ex))
         (set-ind
           (del-ind ex)
           (map (lambda (e) (simp-ex (adj-ex-idx e np lp prc)))
                (e-c-ptr (var-ind ex) lp)
           )
         )
        )
        ((or (is-fn? ex) (is-op? ex))
         (cons (car ex)
               (map (lambda (e) (adj-ex-idx e np lp prc)) (cdr ex))
         )
        )
        (#t ex)
  )
))

(define c-vrs (lambda (rvh ex)
  (let ((v (hash-ref rvh ex #f)))
    (if (is-var? v)
        v
        (if (or (is-op? ex) (is-fn? ex))
            (cons (car ex)
                  (map (lambda (x) (c-vrs rvh x)) (cdr ex))
            )
            ex
        )
    )
  )
))

(define exp-cod (lambda (cod np lp imin)
  (letrec* ((ref-cnt 0)
            (ref-cnt-mtx (make-mutex))
            (rhs (make-hash-table))   ;; (ex -> ref) with short exs
            (rrhs (make-hash-table))  ;; (ref -> ex) with short exs
            (vrfs2 (make-hash-table)) ;; (var -> ex) for source cod with expanded exs
            (vrfs  (make-hash-table)) ;; (var -> ex) for source cod with short exs
            (rfs2 (make-hash-table))         ;; (ref -> ex) with full exs
            
            (get-ref (lambda (ex)
              (let ((r2 `(REF ,ref-cnt)))
                (set! ref-cnt (+ ref-cnt 1))
                (hash-set! rhs ex r2)
                (hash-set! rrhs r2 ex)
                r2
              )
            ))
            
            (e-vrfs2-cache (make-hash-table))
            
            (e-vrfs2 (lambda (ex)
              (let ((r (hash-ref e-vrfs2-cache ex #f)))
                (if r
                    r
                    (let ((res (if (is-var? ex)
                                   (hash-ref vrfs2 ex ex)
                                   (if (or (is-op? ex) (is-fn? ex))
                                       (cons (car ex) (map e-vrfs2 (cdr ex)))
                                       ex
                                   )
                               )
                          )
                         )
                      (hash-set! e-vrfs2-cache ex res)
                      res
                    )
                )
              )
            ))
            
            
            
            (mkref-cache (make-hash-table))
            
            (mkref (lambda (ex)
              (let* ((res1 (hash-ref mkref-cache ex #f))
                     (res2 (if res1
                               res1
                               (cond ((or (is-fn? ex) (is-op? ex))
                                      (let* ((exv (map mkref (cdr ex)))
                                             (ex2 (cons (car ex) exv))
                                             (rf (get-ref ex2))
                                            )
                                        (hash-set! rfs2 rf (e-vrfs2 ex))
                                        rf
                                      )
                                     )
                                     ((and (is-var? ex) (var-has-ind? ex))
                                      (let ((rf (get-ref ex)))
                                        (hash-set! rfs2 rf ex)
                                        rf
                                      )
                                     )
                                     (#t ex)
                               )
                           )
                     )
                    )
                (if (not res1) (hash-set! mkref-cache ex res2))
                res2
              )
            ))
            
            (tvrs (make-hash-table)) ;; (ref-id -> var)
            
            (mkrefs (lambda (l)
              (shdot)
              (if (is-set-val? l)
                  (let ((r (mkref (caddr l))))
                    (hash-set! vrfs2 (cadr l) (caddr l))
                    (hash-set! vrfs  (cadr l) r)
                   `(SET_VAL ,(cadr l) ,r)
                  )
                  l
              )
            ))
            
            (cods (dtim "cods" (map (lambda (l)
                             (shdot)
                             (if (is-set-val? l)
                                `(SET_VAL ,(cadr l) ,(simp-ex (caddr l)))
                                 l
                             )
                           )
                           cod
                  ))
            )
            
            (cd1 (dtim "mkrefs" (map mkrefs cods)))
            
            (rhc (dtim "rhc" (letrec* ((h (make-hash-table))   ;; (ref -> '(cnt ex #f)) #t means protected ref, short ex
                           (excnt (lambda (ex)
                             (if (is-ref? ex)
                                 (let* ((ex1 (hash-ref rrhs ex #f))
                                        (cnt (car (hash-ref
                                                    h
                                                    ex
                                                   `(,(if (and
                                                            (is-var? ex1)
                                                            (var-has-ind? ex1)
                                                          )
                                                          1
                                                          0
                                                      )
                                                    )
                                                  )
                                             )
                                        )
                                       )
                                   (hash-set! h ex `(,(+ 1 cnt) ,ex1 #f))
                                   (if (= 0 cnt) (shdot))
                                   (excnt ex1)
                                 )
                                 (if (or (is-op? ex) (is-fn? ex))
                                     (for-each excnt (cdr ex))
                                 )
                             )
                           ))
                          )
                   (for-each excnt (map caddr (filter is-set-val? cd1)))
                   h
                 ))
            )
            
            (e-ex (lambda (ex n)
              (cond ((is-ref? ex) (e-rf ex n))
                    ((or (is-fn? ex) (is-op? ex))
                     (let* ((exr (map (lambda (e) (e-ex e n)) (cdr ex)))
                            (ecd (apply append (map cdr exr)))
                            (exv (map car exr))
                            (ex1 (cons (car ex) exv))
                           )
                       (cons ex1 ecd)
                     )
                    )
                    (#t (list ex))
              )
            ))
            (e-rf (lambda (r n)
              (let ((v (hash-ref tvrs r #f)))
                (if v
                    (list v)
                    (let ((rr (hash-ref rhc r #f)))
                      (if rr
                          (if (and (not (caddr rr)) (>= n (car rr)))
                              (e-ex (cadr rr) (car rr))
                              (let* ((tv (get-float-var)))
                                (hash-set! tvrs r tv)
                                (cons tv (e-sv `(SET_VAL ,tv ,(cadr rr)) (car rr)))
                              )
                          )
                          (int-err "Unknown ref-id!")
                      )
                    )
                )
              )
            ))
            (e-sv (lambda (e n)
              (if (is-set-val? e)
                  (let* ((er (e-ex (caddr e) n))
                         (ere (car er))
                         (erc (cdr er))
                        )
                    (append erc (list `(SET_VAL ,(cadr e) ,ere)))
                  )
                  (list e)
              )
            ))
            (rf2rf (make-hash-table)) ;; (ref_i -> ref_i-1) 
            
            (rfs2-l (hash->assoc rfs2))
           )
    (if np
        (letrec*
          ((mk-erh (lambda (rh np lp prc)
             (let ((h (make-hash-table)))
               (for-each
                 (lambda (erf)
                   (hash-set! h (car erf) (cadr erf))
                 )
                 (map
                   (lambda (rfex)
                     (list (adj-ex-idx (cadr rfex) np lp prc)
                           (car rfex)
                     )
                   )
                   rh
                 )
               )
               h
             )
           ))
           (ex-0 (dtim "ex-0" (mk-erh rfs2-l np lp (lambda (x) `(- ,x 0)))))
           (ex-1 (dtim "ex-1" (mk-erh rfs2-l np lp (lambda (x) `(- ,x 1)))))
           (ex-0-l (hash->assoc ex-0))
          )
          (for-each
            (lambda (ex0rf0)
              (let ((rf1 (hash-ref ex-1 (car ex0rf0) #f)))
                (if rf1
                    (let ((rfc0 (hash-ref rhc (cadr ex0rf0) #f))
                          (rfc1 (hash-ref rhc rf1 #f))
                         )
                      (hash-set! rf2rf (cadr ex0rf0) rf1)
                      (if (and rfc0 rfc1)
                          (begin
                            (hash-set! rhc
                                       (cadr ex0rf0)
                                      `(,(car rfc0) ,(cadr rfc0) ,#t)
                            )
                            (hash-set! rhc rf1 `(,(car rfc1) ,(cadr rfc1) ,#t))
                          )
                          (int-err "Ref count not found!")
                      )
                    )
                )
              )
            )
            ex-0-l
          )
        )
    )
    (letrec*
      ((cod12 (apply append (map (lambda (x) (e-sv x 1)) cd1)))
       (vrt (let ((h (make-hash-table)))  ;; var deps tree (var_id -> (var_id -> #t))
              (if np
                  (for-each
                    (lambda (sv)
                      (hash-set! h (var-id (cadr sv))
                        (letrec*
                          ((h1 (make-hash-table))
                           (eex (lambda (ex)
                             (if (is-var? ex)
                                 (let ((h2 (hash-ref h (var-id ex) #f)))
                                   (if h2
                                       (hash-for-each
                                         (lambda (v t) (hash-set! h1 v #t))
                                         h2
                                       )
                                   )
                                   (if (var-has-ind? ex) (for-each eex (var-ind ex)))
                                   (hash-set! h1 (var-id ex) #t)
                                 )
                                 (if (or (is-op? ex) (is-fn? ex))
                                     (for-each eex (cdr ex))
                                 )
                             )
                           ))
                          )
                          (eex (caddr sv))
                          h1
                        )
                      )
                    )
                    (filter is-set-val? cod12)
                  )
              )
              h
            )
       )
       (vr2vr (let ((h (make-hash-table)))
                (hash-for-each
                  (lambda (rf0 rf-1)
                    (let ((vr1 (hash-ref tvrs rf0  #f))
                          (vr2 (hash-ref tvrs rf-1 #f))
                         )
                      (if (and rf0 rf-1)
                          (hash-set! h vr1 vr2)
                          (int-err "rf0 or rf-1 is false!")
                      )
                    )
                  )
                  rf2rf
                )
                h
              )
       )
       
       (gh (lambda (l)
         (if (and (not (null? l))
                  (not (is-set-val? (car l)))
             )
             (cons (car l) (gh (cdr l)))
             (list)
         )
       ))
       
       (cod0 (gh cod12))
       
       (es-i-min (lambda (ex)
         ex
    ;     (cond ((and (is-ptr? ex) (= (cadr ex) np))
    ;            (car imin)
    ;           )
    ;           ((and (is-var? ex) (var-has-ind? ex))
    ;            (set-ind (del-ind ex) (map es-i-min (e-c-ptr (var-ind ex) lp)))
    ;           )
    ;           ((or (is-op? ex) (is-fn? ex))
    ;            (cons (car ex) (map es-i-min (cdr ex)))
    ;           )
    ;           (#t ex)
    ;     )
       ))
       
       (s-i-min (lambda (sv)
        `(SET_VAL ,(cadr sv) ,(es-i-min (caddr sv)))
       ))
       
       (cod1 (let ((tv (make-hash-table)))  ;; Already added vars (var_id -> #t)
               (apply append
                 (map (lambda (sv)
                        (if (hash-ref vr2vr (cadr sv) #f)
                            (let ((vh (hash-ref vrt (var-id (cadr sv)))))
                              (hash-set! tv (var-id (cadr sv)) #t)
                              (append
                                (apply
                                  append
                                  (map
                                    (lambda (sv2)
                                      (if (and (hash-ref vh (var-id (cadr sv2)) #f)
                                               (not (hash-ref tv 
                                                              (var-id (cadr sv2))
                                                              #f
                                                    )
                                               )
                                          )
                                          (begin
                                            (hash-set! tv (var-id (cadr sv2)) #t)
                                            (list (s-i-min sv2))
                                          )
                                          (list)
                                      )
                                    )
                                    (filter is-set-val? cod12) ;; !!!!!!!!!!!!!!!!!
                                  )
                                )
                                (list (s-i-min sv))
                              )
                            )
                            (list)
                        )
                      )
                      (filter is-set-val? cod12) ;; !!!!!!!!!!!!!!!!!!!!!
                 )
               )
             )
       )
       (cod2 (filter
               (lambda (l)
                 (or (not (is-set-val? l))
                     (not (hash-ref vr2vr (cadr l) #f))
                 )
               )
               (list-tail cod12 (length cod0))
             )
       )
       (vrt2 (let ((h (make-hash-table))) ;; vars used in cod2 (var_id -> #t)
               (for-each
                 (lambda (ex)
                   (letrec* 
                     ((eex (lambda (e)
                        (if (is-var? e)
                            (hash-set! h (var-id e) #t)
                            (if (or (is-op? e) (is-fn? e))
                                (for-each eex (cdr e))
                            )
                        )
                      ))
                     )
                     (eex ex)
                   )
                 )
                 (map caddr (filter is-set-val? cod2))
               )
               h
             )
       )
       (cd3vr (make-hash-table)) ;; vars already added into cod3
       (vrcd3 (lambda (v1 v2)
         (if (and (not (hash-ref cd3vr (var-id v1) #f))
                  (hash-ref vrt2 (var-id v1) #f)
             )
             (let* ((rt (if (equal? (var-id v1) (var-id v2))
                            (list)
                            (begin
                              (hash-set! vrt2 (var-id v1) #t)
                              (hash-set! vrt2 (var-id v2) #t)
                              (append
                               `((SET_VAL ,v1 ,v2))
                                (if (equal? (var-id v1) (var-id v2))
                                    (list)
                                    (let ((v3 (hash-ref vr2vr v2 #f)))
                                      (if v3 
                                          (vrcd3 v2 v3)
                                          (list)
                                      )
                                    )
                                )
                              )
                            )
                        )
                    )
                   )
               (hash-set! cd3vr (var-id v1) #t)
               rt
             )
             (list)
         )
       ))
       (cod3 (apply append (hash-map->list vrcd3 vr2vr)))
       
       (count-vrs (lambda (cod)
         (letrec* 
           ((h (make-hash-table))
            (c-vrs-ex (lambda (ex)
              (if (is-var? ex)
                  (hash-set! h ex (+ 1 (hash-ref h ex 0)))
                  (if (or (is-op? ex) (is-fn? ex))
                      (for-each c-vrs-ex (cdr ex))
                  )
              )
            ))
           )
           (for-each c-vrs-ex (map caddr (filter is-set-val? cod)))
           h
         )
       ))
       
       (comp-cod (lambda (cod prot)
         (letrec*
           ((cvrs (count-vrs cod))
            (vrpt (make-hash-table))
            (rpx (lambda (ex)
              (if (is-var? ex)
                  (hash-ref vrpt ex ex)
                  (if (or (is-op? ex) (is-fn? ex))
                      (cons (car ex) (map rpx (cdr ex)))
                      ex
                  )
              )
            ))
           )
           (filter
             (lambda (x) x)
             (map
               (lambda (cd)
                 (if (is-set-val? cd)
                     (let* ((vr (cadr cd))
                            (ex (rpx (caddr cd)))
                            (cnt (hash-ref cvrs vr 0))
                           )
                       (if (or (= cnt 0) (hash-ref prot (var-id vr) #f))
                          `(SET_VAL ,vr ,ex)
                           (if (or (and (is-var? ex)
                                        (not (var-has-ind? ex))
                                   )
                                   (= cnt 1))
                               (begin
                                 (hash-set! vrpt vr (hash-ref vrpt ex ex))
                                 #f
                               )
                              `(SET_VAL ,vr ,ex)
                           )
                       )
                     )
                     cd
                 )
               )
               cod
             )
           )
         )
       ))
       
       (vrt3 (let ((h (make-hash-table)))
               (for-each
                 (lambda (x)
                   (hash-set! h (var-id (car x)) #t)
                   (hash-set! h (var-id (cadr x)) #t)
                 )
                 (map cdr (filter is-set-val? cod3))
               )
               (for-each
                 (lambda (x)
                   (hash-set! h (var-id x) #t)
                 )
                 (map cadr (filter is-set-val? cod))
               )
               h
             )
       )
       
       (cod1c (comp-cod cod1 vrt2))
       (cod2c (comp-cod cod2 vrt3))
       
       (ex-var-deps (lambda (ex)
         (if (is-var? ex)
             (list ex)
             (if (or (is-op? ex) (is-fn? ex))
                 (apply append (map ex-var-deps (cdr ex)))
                 (list)
             )
         )
       ))
       
       (mk-var-deps (lambda (cd)
         (letrec*
           ((var-deps (make-hash-table))
            (mvd-sv (lambda (sv)
              (let* ((vr (cadr sv))
                     (ex (caddr sv))
                     (vdl (let ((h (make-hash-table)))
                            (for-each
                              (lambda (v)
                                (if (not (var-eq? v vr))
                                    (begin
                                      (if (not (hash-ref h v #f))
                                          (for-each
                                            (lambda (v1) (hash-set! h v1 #t))
                                            (car (hash-ref var-deps v '(()())))
                                          )
                                      )
                                      (hash-set! h v #t)
                                    )
                                )
                              )
                              (ex-var-deps ex)
                            )
                            (hash-map->list (lambda (v t) v) h)
                          )
                     )
                    )
                (for-each
                  (lambda (v)
                    (let ((r (hash-ref var-deps v #f)))
                      (if r (hash-set! (cadr r) vr #t))
                    )
                  )
                  vdl
                )
                (hash-set! var-deps vr `(,vdl ,(make-hash-table)))
              )
            ))
            (var-deps2 (make-hash-table))
           )
           (for-each mvd-sv (filter is-set-val? cd))
           (hash-for-each
             (lambda (v r)
               (hash-set! var-deps2
                          v
                          (list
                            (filter
                              (lambda (v1) (hash-ref var-deps v1 #f))
                              (car r)
                            )
                            (hash-map->list
                              (lambda (v1 t) v1)
                              (cadr r)
                            )
                          )
               )
             )
             var-deps
           )
           var-deps2
         )
       ))
       
       (comp-vars (lambda (cd prot frvr)
         (letrec*
           ((tmp-vr (make-hash-table))
            (free-vr frvr)
            (v-d (let ((h (make-hash-table)))
                   (hash-for-each
                     (lambda (v r)
                       (if (= (cadr (var-id v)) 103)
                         (format #t "V12: ~a\n" (cadr r))
                       )
                       (if (= (cadr (var-id v)) 98)
                         (format #t "V27: ~a\n" (car r))
                       )
                       (if (or (hash-ref prot (var-id v) #f)
                               (not (null? (cadr r)))
                           )
                           (hash-set!
                             h
                             v 
                            `(,(+ (length (car r)) (length (cadr r)))
                               #t
                              ,(car r)
                              ,(cadr r)
                             )
                           )
                       )
                     )
                     (mk-var-deps cd)
                   )
                   h
                 )
            )
            (cd-h (let ((h (make-hash-table)))
                    (for-each
                      (lambda (sv)
                        (hash-set! h (cadr sv) (caddr sv))
                      )
                      (filter is-set-val? cd)
                    )
                    h
                  )
            )
            (rp-ex (lambda (ex)
             ;; (format #t "RPEX: ~a\n" ex)
              (if (is-var? ex)
                  (hash-ref tmp-vr ex ex)
                  (if (or (is-op? ex) (is-fn? ex))
                      (cons (car ex) (map rp-ex (cdr ex)))
                      ex
                  )
              )
            ))
            (add-sv (lambda (v0)
              (let* ((r (hash-ref v-d v0 #f))
                     (cnt (list-ref r 0))
                     (flg (list-ref r 1))
                     (hd  (list-ref r 2))
                     (tl  (list-ref r 3))
                     
                     (v (if (and (not (hash-ref prot v0 #f))
                                 (hash-ref cd-h v0 #f)
                                 (not (null? free-vr))
                                 flg
                            )
                            (let ((v1 (car free-vr)))
                              (hash-set! tmp-vr v0 v1)
                              (set! free-vr (cdr free-vr))
                              (format #t "QQQ: ~a -> ~a!\n" v0 v1)
                              v1
                            )
                           v0
                        )
                     )
                     (ex (rp-ex (hash-ref cd-h v0 #f)))
                    )
              (if (and flg
                       (not (hash-ref prot v0 #f))
                            (hash-ref cd-h v0 #f)
                            (not (null? free-vr))
                  )
                (format #t "ASV!\n")
              )
                (if (not ex)
                    (begin
                      (format #t "VVV: ~a\n" v)
                      (int-err "Cannot find ESV!")
                    )
                )
                (if flg
                    (begin
                      (for-each
                        (lambda (vr)
                          (let ((rr (hash-ref v-d vr #f)))
                            (if rr
                                (let ((tl1 (filter 
                                             (lambda (x) (not (var-eq? x v0)))
                                             (list-ref rr 3)
                                           )
                                      )
                                     )
                                  (hash-set!
                                    v-d
                                    vr
                                   `(,(list-ref rr 0)
                                     ,(list-ref rr 1)
                                     ,(list-ref rr 2)
                                     ,tl1
                                    )
                                  )
                                  (if (and (null? tl1)
                                           (not (hash-ref prot (var-id vr) #f))
                                      )
                                      (begin
                                        (format #t "FREE: ~a ~a\n" vr (hash-ref tmp-vr vr #f))
                                        (set! free-vr
                                              (cons
                                                (hash-ref tmp-vr vr vr)
                                                free-vr
                                              )
                                        )
                                      )
                                  )
                                )
                            )
                          )
                        )
                        hd
                      )
                      (for-each
                        (lambda (vr)
                          (let ((rr (hash-ref v-d vr #f)))
                            (if rr
                                (begin
                                  (hash-set!
                                    v-d
                                    vr
                                    (cons (- (car rr) 1) (cdr rr))
                                  )
                                )
                            )
                          )
                        )
                        (append tl hd)
                      )
                      (let ((rr (hash-ref v-d v0 #f)))
                        (hash-set!
                          v-d v0 `(,(car rr) #f ,(caddr rr) ,(cadddr rr))
                        )
                      )
                      (append (apply append (map add-sv hd))
                             `((SET_VAL ,v ,ex))
                      )
                    )
                   '()
                )
              )
            ))
            (mkcd (lambda (sv)
              (let ((l (sort (filter
                               (lambda (x) x)
                               (hash-map->list
                                 (lambda (v r)
                                   (if (cadr r)
                                       (list (car r) v)
                                       #f
                                   )
                                 )
                                 v-d
                               )
                             )
                             (lambda (x y) (< (car x) (car y)))
                       )
                    )
                   )
                (if (null? l)
                   '()
                    (add-sv (cadr (car l)))
                )
              )
            ))
           )
           (list (apply append (map mkcd cd)) (list))
         )
       ))
;       (cod1r2r (let* ((c1r (comp-vars cod1c vrt2 (list)))
;                       (cod1r (car c1r))
;                       (frv (cadr c1r))
;                       (c2r (comp-vars cod2c vrt3 frv))
;                       (cod2r (car c2r))
;                      )
;                  (list cod1r cod2r)
;                )
;       )
;       (cod1r (car  cod1r2r))
;       (cod2r (cadr cod1r2r))
      )
      (list (append
              (if np
               `((LOOP_PRE_CODE ,np ,(car imin) 
                                ,(cons 'CODE_BEGIN (append cod0 cod1c))
                 )
                )
                (list)
              )
              cod0
              cod2c
              cod3
            )
            (hash-map->list (lambda (k v) v) tvrs)
      )
    )
  )
))

(def-cache rep-cond-ex (lambda (ex)
  (if (or (is-op? ex) (is-fn? ex))
      (let ((op (car ex))
            (args (map rep-cond-ex (cdr ex)))
           )
        (cond ((eq? op 'and)                 ;; X and Y -> X*Y
               (if (null? args)
                   1.0
                   (if (= (length args) 1)
                       (car args)
                       (cons '* args)
                   )
               )
              )
              ((eq? op 'or)                  ;; X or Y  -> max(X+Y,1.0)
               (if (null? args)
                   0.0
                   (if (= (length args) 1)
                       (car args)
                      `(min 1.0 ,(cons '+ args))
                   )
               )
              )
              ((eq? op 'not)                 ;; not(X)  -> 1.0-X
              `(- 1.0 ,(car args))
              )
              ((eq? op '=)                   ;; X=Y  -> abs(min(0.0,sign(max(X,Y)-min(X,Y)-epsilon)))
              `(abs (min 0.0 (sign (- ,(cons 'max args)
                                      ,(cons 'min args)
                                       (epsilon)
                                   )
                             )
                    )
               )
              )
              ((eq? op '>=)                  ;; X>=Y  -> max(sign(X-Y),0.0)
              `(max (sign (- ,(car args) ,(cadr args))) 0.0)
              )
              ((eq? op '<=)                  ;; X<=Y  -> max(sign(Y-X),0.0)
              `(max (sign (- ,(cadr args) ,(car args))) 0.0)
              )
              ((eq? op '>)                   ;; X>Y  -> max(sign(X-Y-epsilon),0.0)
              `(max (sign (- ,(car args) ,(cadr args) (epsilon))) 0.0)
              )
              ((eq? op '<)                   ;; X<Y  -> max(sign(Y-X-epsilon),0.0)
              `(max (sign (- ,(cadr args) ,(car args) (epsilon))) 0.0)
              )
              ((eq? op 'if)
               (let* ((tru (rep-cond-ex (caddr ex)))
                      (fls (rep-cond-ex (cadddr ex)))
                      (c1  (rep-cond-ex (cadr ex)))
                      (c2 `(- 1.0 ,c1))
                     )
                `(+ (* ,c1 ,tru) (* ,c2 ,fls))
               )
              )
              (#t (cons op args))
        )
      )
      (cond ((eq? ex #t) 1.0)
            ((eq? ex #f) 0.0)
            (#t ex)
      )
  )
))

(define rep-cond (lambda (cod)
  (map (lambda (l)
         (if (is-set-val? l)
            `(SET_VAL ,(cadr l) ,(rep-cond-ex (caddr l)))
             l
         )
       )
       cod
  )
))

(define optimizer:make-exp-sv (lambda ar
;;  (statprof-reset 0 500 #f)
;;  (statprof-start)

  ;;(format #t "ESV: ~a\n" ar)

  (let ((oc (dtim "make-exp-sv" (exp-cod (rep-cond (car ar))
                     (if (> (length ar) 1) (cadr ar) #f)
                     (if (> (length ar) 2) (caddr ar) #f)
                     (if (> (length ar) 3) (cadddr ar) #f)
            ))
        )
        ;;(oc `(,(car ar) ()))
       )
  ;;  (free-vars (cadr oc))
;;    (statprof-stop)
;;    (statprof-display)
;;    (report-syms)
    (apply beg (cons (apply omp-locals (cadr oc)) (car oc)))
  )
))

(define last-loop #f)
(define last-pre-code `(,nop))
(define tmp-consts (make-hash-table)) ;; (var-id -> ex)
(define cr-ptr '())
(define max-const-rank 10000000)

(define optimizer:set-max-const-rank (lambda (n)
  (set! max-const-rank n)
))

(define wrap-loop-pre-code (lambda (bl)
  (let ((pre-i (cadr bl))
        (pre-m (caddr bl))
        (pre-cod (cadddr bl))
        (optr cr-ptr)
       )
    (if last-loop
        (let* ((dms (car last-loop))
               (seq (cadr last-loop))
               (i (car seq))
               (m (car (list-ref dms (car seq))))
              )
          (if (and (= i pre-i) (equal? m pre-m))
              (begin
                (set! cr-ptr
                      (cons (car (list-ref dms (car seq)))
                            (cdr cr-ptr)
                      )
                )
                (force-code pre-cod)
                (set! cr-ptr optr)
                (set! last-pre-code (cons pre-cod last-pre-code))
                nop
              )
              (int-err "Invalid PRE_CODE section!")
          )
        )
        (int-err "Orphan PRE_CODE section!")
    )
  )
))


(define wrap-set-ptr (lambda (cod)
  (set! cr-ptr (cadr cod))
  ;;(format #t "CPTR: ~a\n" cr-ptr)
  cod
))

(define wrap-loop (lambda (bl)
  (let* ((dms (cadr (obj-find-el bl 'LOOP_DIMS)))
         (seq (cadr (obj-find-el bl 'LOOP_SEQ)))
         (cod (cadr (obj-find-el bl 'LOOP_CODE)))
         (pcd (let ((cd (obj-find-el bl 'LOOP_PRE_CODE)))
                (if cd (cadr cd) nop)
              )
         )
         (ll last-loop)
         (lpc last-pre-code)
         (optr cr-ptr)
         (lptr (append (map cur-ptr (iota1 (length seq))) cr-ptr))
         (pptr (append (list (car (list-ref dms (car seq))))
                       (map cur-ptr (iota1 (dec (length seq))))
                       cr-ptr
               )
         )
        )
     (set! last-loop (list dms seq))
     (set! last-pre-code `(,pcd))
     (hash-clear! tmp-consts)
	
     (set! cr-ptr pptr)
     (force-code pcd)
     (set! cr-ptr lptr)
     (force-code cod)

     (hash-clear! tmp-consts)

     (let* ((prc (cons 'CODE_BEGIN last-pre-code))
            (rc `(CODE_LOOP (LOOP_DIMS ,dms) 
                            (LOOP_SEQ  ,seq)
                            (LOOP_PRE_CODE ,prc)
                            (LOOP_CODE ,cod)
                 )
            )
           )
;;       (format #t "PCD2: ~a ::: ~a\n" last-pre-code prc)
       (set! last-loop ll)
       (set! last-pre-code lpc)
       (set! cr-ptr optr)
       rc
     )
  )
))

(define wrap-exp-sv (lambda (bl)
    (let ((lpc (force-code (cdr bl))))
;;      (format #t "ESV!\n")
      (if last-loop
          (let* ((d (car last-loop))
                 (i (car (cadr last-loop)))
                 (dd (list-ref d i))
                 (l (length d))
                )
            (optimizer:make-exp-sv lpc i l dd)
          ;;  (optimizer:make-exp-sv lpc)
          )
          (optimizer:make-exp-sv lpc)
      )
    )
))

(define not-cons (make-hash-table)) ;; (var-id -> #t)
(define cons-ex (make-hash-table)) ;; (var-id -> ex)

(define is-ex-const? (lambda (ex0 cvr)
  (letrec* ((iec? (lambda (ex)
              (or (number? ex)
                  (and (is-var? ex) 
                       (not (and cvr (equal? (var-id ex) (var-id cvr))))
                       (not (hash-ref not-cons (var-id ex) #f))
                       (is-float? ex)
                       (not (var-has-ind? ex))
                  )
                  (and (or (is-op? ex) (is-fn? ex))
                       (and-map iec? (cdr ex))
                  )
              )
            ))
           )
    (iec? ex0)
  )
))

(define wrap-set-val-3 (lambda (sv)
  (let ((vr0 (cadr sv))
        (ex0 (simp-ex (rep-cond-ex (caddr sv))))
        (rm-const 
          (lambda (vr)
            ;;(format #t "RM: ~a ~a\n" (var-name vr) (var-id vr))
            (hash-set! not-cons (var-id vr) #t)
          )
        )
       )
    (if (is-ex-const? ex0 vr0)
        (if (not (hash-ref not-cons (var-id vr0) #f))
            (if (equal? (hash-ref cons-ex (var-id vr0) ex0) ex0)
                (hash-set! cons-ex (var-id vr0) ex0)
                (rm-const vr0)
            )
        )
        (rm-const vr0)
    )
   `(,(car sv) ,vr0 ,ex0)
  )
))

(define wrap-run-4 (lambda (cod)
  (set! last-loop #f)
  (set! last-pre-code `(,nop))
  (set! tmp-consts (make-hash-table)) ;; (var-id -> ex)
  (set! cr-ptr '())

  (for-each
    (lambda (vid-ex)
      (if (not (and (not (hash-ref not-cons (car vid-ex) #f)) 
                    (is-ex-const? (cadr vid-ex) #f)
               )
          )
          (begin
            (hash-remove! cons-ex (car vid-ex))
            (hash-set! not-cons (car vid-ex) #t)
          )
      )
    )
    (hash->assoc cons-ex)
  )
  cod
))

(define is-ex-const-ptr? (lambda (ex)
  (or (number? ex)
      (is-ptr? ex)
      (and (is-var? ex)
           (is-float? ex)
           (or (not (hash-ref not-cons (var-id ex) #f))
               (hash-ref tmp-consts (var-id ex) #f)
           )
      )
      (and (or (is-fn? ex) (is-op? ex))
           (and-map is-ex-const-ptr? (cdr ex))
      )
  )
))

(define cons-ex2   (make-hash-table)) ;; ((ex (dms seq)/()) -> #t)

(define exp-tmpc (lambda (ex)
  (if (is-var? ex)
      (let* ((e1 (hash-ref tmp-consts (var-id ex) #f))
             (e2 (if e1 e1 (hash-ref cons-ex (var-id ex) #f)))
            )
        (if e2 (exp-tmpc e2) ex)
      )
      (if (or (is-op? ex) (is-fn? ex))
          (cons (car ex) (map exp-tmpc (cdr ex)))
          ex
      )
  )
))




(define wrap-set-val-4 (lambda (sv)
  (letrec* ((vr0 (cadr sv))
            (ex0 (caddr sv))
            (ex1 (exp-tmpc ex0))
            (e-c-exs (lambda (ex)
              (if (and (not (number? ex)) (is-ex-const-ptr? ex))
                  (let* ((ex2 (exp-tmpc ex))
                         (lp1 (if last-loop
                                  (list last-loop cr-ptr)
                                 '()
                              )
                         )
                        )
                    (hash-set! cons-ex2 (list ex2 lp1) #t)
                  )
                  (if (or (is-op? ex) (is-fn? ex))
                      (map e-c-exs (cdr ex))
                  )
              )
            ))
           )
    (if (and (is-ex-const-ptr? ex0) 
             (not (hash-ref not-cons (var-id vr0) #f))
        )
        (begin
          ;; (format #t "TCNS: ~a = ~a\n" (infix-out vr0) (infix-out ex0))
          (hash-set! tmp-consts (var-id vr0) ex1)
        )
    )
    (e-c-exs ex1)
   `(,(car sv) ,vr0 ,ex0)
  )
))

(define const-v    (make-hash-table)) ;; ((ex lp) -> var)
(define const-v-ex (make-hash-table)) ;; (ex -> var)
(define const-cmd  (make-hash-table)) ;; (var -> cmd)

(define wrap-set-val-5 (lambda (sv)
  (letrec* ((vr (cadr sv))
            (ex (caddr sv))
            (ex1 (exp-tmpc ex))
            (rep-cns (lambda (e)
              (hash-ref const-v
                        (list e (list last-loop cr-ptr))
                        (if (or (is-op? e) (is-fn? e))
                            (cons (car e) (map rep-cns (cdr e)))
                            e
                        )
              )
            ))
           )
    (if (is-ex-const-ptr? ex)
        (hash-set! tmp-consts (var-id vr) ex1)
    )
    (beg
      (if (and (hash-ref const-v (list ex1 (list last-loop cr-ptr)) #f)
               (not (hash-ref not-cons (var-id vr)))
          )
          nop
         `(,(car sv) ,vr ,(rep-cns ex1))
      )
      ;;`(,(car sv) ,vr ,ex1)
    )
  )
))

(define wrap-run-code-5 (lambda (cod)
  (set! last-loop #f)
  (set! last-pre-code `(,nop))
  (set! tmp-consts (make-hash-table)) ;; (var-id -> ex)
  (set! cr-ptr '())

  (hash-for-each
    (lambda (ex0lp tr)
      (let* ((ex0 (car ex0lp))
             (lp (cadr ex0lp))
             (gdms (lambda (ex)
               (letrec* ((llp (car lp))
                         (cptr (cadr lp))
                         (dms (car llp))
                         (seq (cadr llp))
                         
                         (rep-ptr (lambda (e)  ;; replace ptrs to orig ptrs
                           (if (and (is-ptr? e) (not (is-orig-ptr? e)))
                               (list-ref cptr (cadr e))
                               (if (or (is-op? e) (is-fn? e))
                                   (cons (car e) (map rep-ptr (cdr e)))
                                   e
                               )
                            )
                          ))
                          
                          (ex1 (rep-ptr ex))
                          (pth (make-hash-table))
                          
                          (get-pts (lambda (e)
                            (if (is-ptr? e)
                                (hash-set! pth 
                                           (cadr e)
                                           (list-ref dms
                                                     (list-ref seq (cadr e))
                                           )
                                )
                                (if (or (is-op? e) (is-fn? e))
                                    (cons (car e) (map get-pts (cdr e)))
                                    e
                                )
                            )
                          ))
                         )
                 (get-pts ex1)
                 (let* ((res (map (lambda (d) 
                                    (map simp-ex (hash-ref pth d '()))
                                  )
                                  seq
                             )
                        )
                        (rn (filter (pip not null?) res))
                       )
                       (if (null? rn)
                            '()
                             res
                       )
                 )
               )
             ))
             (edms (if (null? lp) '() (gdms ex0)))
             (ndms (filter (pip not null?) edms))
             (dims (map (lambda (d) (+ 1 (- (cadr d) (car d))))
                        ndms
                   )
             )
             (ndims (length dims))
            )
           
        (if (or (is-op? ex0) (is-fn? ex0))
            (let* ((v (comp-array (comp-float "cns") dims))
                   (il (let ((h (make-hash-table))
                             (dcnt 0)
                            )
                         (for-each (lambda (dm)
                                     (if (not (null? (cadr dm)))
                                         (begin
                                           (hash-set! h
                                                      dcnt
                                                     `(,(car dm) 
                                                       ,(car (cadr dm))
                                                      )
                                           )
                                           (set! dcnt (inc dcnt))
                                         )
                                     )
                                   )
                                   (zip (iota1 (length edms)) edms)
                         )
                         (map (lambda (d) (hash-ref h d #f))
                              (iota1 ndims)
                         )
                       )
                   )
                   (ol (let ((h (make-hash-table))
                             (dcnt 0)
                            )
                         (for-each (lambda (dm)
                                     (if (not (null? (cadr dm)))
                                         (begin
                                           (hash-set! h
                                                      (car dm)
                                                     `(,dcnt
                                                       ,(car (cadr dm))
                                                      )
                                           )
                                           (set! dcnt (inc dcnt))
                                         )
                                     )
                                   )
                                   (zip (iota1 (length edms)) edms)
                         )
                         (map (lambda (d) (hash-ref h d #f))
                              (iota1 (length edms))
                         )
                       )
                   )
                   (ind (map (lambda (o)
                              `(- ,(cur-ptr (car o)) ,(dec (cadr o)))
                             )
                             il
                        )
                   )
                   (ptr (map (lambda (o)
                               (if o
                                  `(+ ,(cur-ptr (car o)) ,(dec (cadr o)))
                                   #f
                               )
                             )
                             ol
                        )
                   )
                   (iv (set-ind v ind))
                   (ekey (list ex0 ind dims))
                   (iv0 (hash-ref const-v-ex ekey #f))
                  )
              (if (<= ndims max-const-rank)
                  (if (not iv0)
                      (begin
                        (hash-set! const-v ex0lp iv)
                        (hash-set! const-v-ex ekey iv)
                        (hash-set! const-cmd
                                   iv
                                   (do-loop dims
                                     (set-ptr ptr)
                                     (set-val (set-ind v (orig-ptr)) ex0)
                                   )
                        )
                      )
                      (hash-set! const-v ex0lp iv0)
                  )
              )
            )
        )
      )
    )
    cons-ex2
  )
  (list 'RUN_CODE
        (beg
          (apply beg (hash-map->list (lambda (v cmd) cmd) const-cmd))
          (raw "")
          (apply beg (force-code (cdr cod)))
        )
  )
))

)


(add-wrapper 1 'CODE_LOOP wrap-loop)
(add-wrapper 1 'EXP_SV wrap-exp-sv)

(add-wrapper 2 'CODE_LOOP wrap-loop)
(add-wrapper 2 'LOOP_PRE_CODE wrap-loop-pre-code)

;; FIXME: support nested loops

;(add-wrapper 3 'SET_VAL wrap-set-val-3)
;
;(add-wrapper 4 'CODE_LOOP wrap-loop)
;(add-wrapper 4 'SET_PTR wrap-set-ptr)
;(add-wrapper 4 'SET_VAL wrap-set-val-4)
;(add-wrapper 4 'RUN_CODE wrap-run-4)
;
;(add-wrapper 5 'RUN_CODE wrap-run-code-5)
;(add-wrapper 5 'SET_VAL wrap-set-val-5)
;(add-wrapper 5 'CODE_LOOP wrap-loop)
;(add-wrapper 5 'SET_PTR wrap-set-ptr)

